- Option
Explicit
- Dim MyIE As
New InternetExplorer
- Private Sub
cmdBrowser_Click(Index As Integer)
- On Error
GoTo BadcmdBrowser:
- Select Case
Index
- Case 0 'Open
explorer
- MyIE.Visible
= True
- Case 1
'close explorer
- MyIE.Visible
= False
- Case 2 'send
URL
- MyIE.Navigate
Text1.Text
- Case 3 'get
url
- Text1.Text =
MyIE.LocationURL
- Case 4 'go
back
- MyIE.GoBack
- Case 5 'go
forward
- MyIE.GoForward
- Case 6
'refresh
- MyIE.Refresh
- Case 7 'end
program
- MyIE.Quit
- Set MyIE =
Nothing
- Unload Me
- End Select
- ExitcmdBrowser:
- Exit Sub
- BadcmdBrowser:
- MsgBox
Err.Description
- Resume
ExitcmdBrowser
- End Sub
- When the
project is run, the QueDemo form is displayed, giving the
user eight actions to select. By clicking the Open
Explorer button, a fully operational instance of the
Internet Explorer will be displayed. The user can
manipulate the Explorer from either the Internet Explorer
itself or from the project form. If the user ends the
Internet Explorer from the Explorer's interface, an
automation error occurs. You will also get an automation
error when trying to go back or forward when there are no
pages to go back or forward to. Using this method to
provide Internet browsing to your applications is very
limited but allows quick implementation. If you are
looking for something a little more robust, read on.
Building Your Own
Browser
The
shdocvw.dll exposes a control called the WebBrowser that
can be dropped on your application's form and provides a
set of events, properties, and methods that gives you
almost complete control over your Web browsing. In this
section, we'll build the shell of a browser application
that can be easily customized to meet organizational
requirements for functionality, security, and so on.
Table 10.1 is a table of controls to be placed on the
form.
Table
10.1 Controls to Place on the Project Form
Control |
Name |
Description |
ToolBar |
MyTools |
A
Win95 common controls toolbar |
TextBox |
txtAddress |
A
text box control with the caption
"Address:" |
ComboBox
|
cmbAddress |
A
style 0 combo box |
CommonDlg
|
cdgFileBox |
A
common dialog box |
PictureBox |
WebContainer |
A
picture control with background set to black |
WebBrowser |
MyWeb |
The
WebBrowser control |
StatusBar |
Status |
A
status bar control |
Arrange
the controls on the frmBrowser.frm as shown in Figure
10.2. In the case of the WebBrowser control, make it a
child of the WebContainer picture box control by first
selecting the picture box and then drawing the WebBrowser
control into it. The txtAddress and cmbAddress controls
can be placed anywhere since they will be sized and moved
into place by program code anyway. The status bar should
have three panels with the last two panels having their
Styles set to Date and Time respectively.
FIG. 10.2
Where do
the browser project controls go?
For the
ToolBar control, set the button properties as shown in
Table 10.2.
Table
11.2 The Button Property settings for the MyTools ToolBar
Button |
Property |
Setting |
1 |
Key |
'GetFile' |
1 |
toolTipText |
'Get
and HTML Document from disk' |
2 |
Key |
'TextPlace' |
2 |
Style |
4-PlaceHolder |
2 |
Width |
1400 |
3 |
Key |
ComboPlace |
3 |
Style |
4-PlaceHolder |
4 |
Key |
'Quit" |
4 |
ToolTipText |
'Close
the browser application' |
5 |
Key |
'GoBack' |
5 |
ToolTipText |
'Go
back to previous page' |
6 |
Key |
'Refresh' |
6 |
ToolTipText |
'Refresh
the current page' |
7 |
Key |
'GoForward' |
7 |
ToolTipText |
'Go
forward to next page' |
8 |
Key |
'GoHome' |
8 |
ToolTipText |
'Go
to home page' |
At this
point, there should be a form with all of the required
controls with properties set up properly. I should make
it clear here that when this project hasbeen completed,
you will have a working browser, but it is not any where
nearcomplete enough for distribution and is only a
vehicle to demonstrate what can be accomplished. You will
have to flesh this project out with appropriate error
handling, user interface, and other enhancements by
yourself. Included on the CD is a file called
clsToolBox.cls that contains some utility procedures that
the project requires. Add this file to the project now.
There are
two public properties exposed by this form, the Location
and ShowStatus properties as shown in Listing 10.2. While
not used anywhere in this project, they are included so
that you can easily add this form and its supporting
clsToolBox class to another project. You can also add
other public properties and methods as needed. By setting
the Location property to a valid URL, you can cause the
results of that URL to be displayed in this form. The
ShowStatus properties allow you to read and write to the
form's status bar.
Listing
10.2 frmbrowser.frmThe General Declarations and
Property Procedures of the frmBrowser Form
- Option
Explicit
- 'class
contains required utility procedures
- Private
clstools As New clsToolBox
- 'contains
the name of the file returned by
- 'the
GetDocumentFile procedure
- Private
strFilePath As String
- '==============Begin
Property Procedures=============
- Public
Property Get Location() As String
- Location =
MyWeb.Location
- End Property
- Public
Property Let Location(strNewValue As String)
- MyWeb.Navigate
strNewValue
- End Property
- Public
Property Get ShowStatus() As String
- ShowStatus =
Status.Panels(1).Text
- End Property
- Public
Property Let ShowStatus(strNewValue As String)
- Status.Panels(1).Text
= strNewValue
- End Property
- The next group
of procedures are general procedures that provide
supporting code to the events triggered by the user or by
the browser. The first procedure in Listing 10.3 is the
GetDocumentFile() function that returns a Boolean True if
the user selected a file and a False if the user cancels.
If the function returns a True, then the file path is
returned through the function's strFileName argument. The
ResizeAll sub procedure maintains the sizing of all of
the controls as the user resizes the form or as the
WebBrowser control changes size due to URL parameters. We
call this procedure from the form's Resize event and from
the WebBrowser's MyWeb_OnDownloadBegin() event. This
gives the WebBrowser an ugly flicker when a given URL is
acted upon, but it was the only solution available with
the beta release Internet Explorer 3.0. The final release
of Internet Explorer 3.0 is supposed to include an
OnWindowResized event that shows some interesting
possibilities, but it was not functional as this book
went to press.
Listing
10.3 frmbrowser.frmThe General Procedures Code
- '=================Begin
General Procedures====================
- Private
Function GetDocumentFile(strFilename) As Boolean
- On Error
GoTo BadGetDocumentFile
- 'assume
success
- GetDocumentFile
= True
- cdgFileBox.Filter
= "HTML Documents *.htm|*.htm|All Files
*.*|*.*"
- cdgFileBox.ShowOpen
- strFilename
= cdgFileBox.filename
- ExitGetDocumentFile:
- Exit
Function
- BadGetDocumentFile:
- GetDocumentFile
= False
- Resume
ExitGetDocumentFile
- End Function
- Private Sub
ResizeAll()
- '============================================
- 'resizes all
visible components to fit form
- '============================================
- Dim MyHeight
As Long
- Dim MyWidth
As Long
- Dim MyTop As
Long
- Dim MyLeft
As Long
- '----Basic
Dimensions-----
- MyHeight =
Me.ScaleHeight
- MyWidth =
Me.ScaleWidth
- '----Calculated
Dimensions------
- If
MyTools.Visible Then MyTop = MyTools.Height
- '----------Resizing---------
- MyTools.Top
= MyTop
- mywebcontainer.Move
0, MyTop, MyWidth, _
- MyHeight -
(150 + (MyTop + Status.Height))
- If
MyWeb.Visible = True Then
- mywebcontainer.Visible
= False
- MyWeb.Move
0, 0, _
- mywebcontainer.Width
- 110, _
- mywebcontainer.Height
- 110
- MyWeb.Container.Visible
= True
- End If
- Status.Panels(1).Width
= MyWidth - 2200
- txtAddress.Left
= MyTools.Buttons(2).Left
- txtAddress.Top
= MyTools.Buttons(2).Top
- cmbAddress.Top
= MyTools.Buttons(3).Top
- cmbAddress.Left
= MyTools.Buttons(3).Left
- cmbAddress.Width
= MyTools.Buttons(3).Width
- txtAddress.ZOrder
- cmbAddress.ZOrder
- End Sub
- Public Sub
AddToList(MyCombo As ComboBox)
- Dim MyText
As String
- MyText =
MyCombo.Text
- If Not
clstools.IsExactComboMatch(MyCombo) Then
- If
MyCombo.ListCount > 20 Then
- MyCombo.RemoveItem
1
- End If
- If
Len(MyText) > 7 And InStr(MyText, "www.")
> 0 Then
- If
Left(MyText, 7) <> "http://" Then
- MyText =
"http://" & MyText
- End If
- Else
- End If
- MyCombo.AddItem
MyText
- MyCombo.ListIndex
= MyCombo.NewIndex
- Else
- End If
- End Sub
- The last
procedure in Listing 10.3 is the AddToList() subroutine.
Its purpose is to check the URLs contained in the
ComboBox passed as an argument to it for duplicates. If
there are no duplicates, it adds the URL to the list.
Also if the list has exceeded 20 entries, it removes an
entry from the list to keep it at the maximum 20 entries.
The subroutine calls a utility procedure from the
clsTools object called IsExactComboMatch().
Listing 10.4 contains
the event code for the form. The Load Event of the
frmBrowser sets the form's caption, adds a URL to the
cmbAddress ComboBox, and displays the browser's home page
as determined by Internet Explorer's system settings.
Listing
10.4 frmbrowser.frmThe From Events Code for the
frm.Browser
- '==============Begin
Event Procedures======================
- Private Sub
Form_Load()
- Me.Show
- Me.Caption =
"Que Special Edition Web Browser"
- cmbAddress.AddItem
"http://www.rt66.com"
- cmbAddress.ListIndex
= cmbAddress.NewIndex
- MyWeb.Visible
= True
- MyWeb.GoHome
- ResizeAll
- End Sub
- Private Sub
Form_Resize()
- If
Me.WindowState <> vbMinimized Then ResizeAll
- End Sub
- Private Sub
Form_Unload(Cancel As Integer)
- Set clsTools
= Nothing
- End Sub
- The form's
Resize event calls the ResizeAll() procedure as long as
the form's window state is not transitioning to the
minimized state. If the ResizeAll() procedure was called
with a minimized window, then invalid property errors
occur. Finally,being a hopeless paranoid and knowing the
OS is out to get me, I make sure that I terminate the
clsTools object by setting the object reference to
nothing.
Moving on to the cmbAddress
and MyTools events, we have Listing 10.5.
Listing
10.5 frmbrowser.frmThe Event Procedures for the
cmbAddress and Mytools Controls
- Private Sub
cmbAddress_KeyPress(KeyAscii As Integer)
- Select Case
KeyAscii
- Case 13
- AddToList
cmbAddress
- MyWeb.Navigate
cmbAddress.Text
- End Select
- End Sub
- Private Sub
MyTools_ButtonClick(ByVal Button As Button)
- On Error
GoTo BadMyTools_ButtonClick
- Select Case
Button.Key
- Case
"GetFile"
- 'go get a
HTML file from a local drive
- If
GetDocumentFile(strFilePath) Then
- MyWeb.Navigate
strFilePath
- End If
- Case
"GoHome"
- MyWeb.GoHome
- Case
"GoBack"
- MyWeb.GoBack
- Case
"GoForward"
- MyWeb.GoForward
- Case
"Refresh"
- MyWeb.Refresh
- Case
"Test"
- MsgBox
MyWeb.Location
- End Select
- ExitMyTools_ButtonClick:
- Exit Sub
- BadMyTools_ButtonClick:
- MsgBox
Err.Description
- Resume
ExitMyTools_ButtonClick
- End Sub
- The cmbAddress
KeyPress() event checks for a carriage return signaling
the end of input and the desire to activate the URL and
load the Web browser. The MyTools_ButtonClick event
provides the navigational tools that allow you to go
back, forward, home, or refresh the HTML document
displayed. If you attempt to navigate to a page that
doesn't exist (no next or previous page), an error is
generated. Those errors are trapped here and displayed in
a message box. They are not fatal errors and merely need
to be trapped to prevent program crashes.
Now we can get to the
WebBrowser's events. In the beta version of the Internet
Explorer, several of the events were not yet functional,
but enough were working that I could make a substantial
browser application. Listing 10.6 provides the event code
for the WebBrowser control.
Listing
10.6 frmbrowser.frmThe Event Code for the
WebBrowser Control
- Private Sub
MyWeb_OnDownloadBegin()
- ResizeAll
- End Sub
- Private Sub
MyWeb_OnDownloadComplete()
- Screen.MousePointer
= vbDefault
- End Sub
- Private Sub
MyWeb_OnNavigate(ByVal URL As String, _
- ByVal Flags
As Long, ByVal TargetFrameName As String, _
- PostData As
Variant, ByVal Headers As String, _
- ByVal
Referrer As String)
- Screen.MousePointer
= vbHourglass
- End Sub
- Private Sub
MyWeb_OnStatusTextChange(ByVal bstrText As String)
- Status.Panels(1).Text
= bstrText
- End Sub
- In the
MyWeb_OnDownloadBegin() event, the ResizeAll procedure is
called to counteract the fact that loading a new URL
causes the WebBrowser control to be resized to
accommodate the size of the HTML document. The ResizeAll
procedure provides the mechanism to pull the WebBrowser's
size back into conformity with the size of its container,
the PictureBox control. In the MyWeb_OnNavigate() and
MyWeb_OnDownloadComplete() events, the mouse pointer is
manipulated to let the user know that something is
happening. In the MyWeb_OnStatusTextChange() event, the
user is notified of the WebBrowser's status through the
status bar control.
One limitation here is that
the WebBrowser control does not return any text
indicating when the mouse pointer is positioned over a
link. All the code is now in place to run the WebBrowser
project. Press F5 to run the project. It should look like
Figure 10.3.
FIG. 10.3
Here's
the WebBrowser project running.
We have
created a minimal Web browser. What can be done with it?
Let's take a situation where we only want the users
within our organization to have limited access to the
Internet. We want to limit this access to the
Microsoft.com site for the purposes of research. We don't
want anyone cruising the net for entertainment on our
time. So built into our organization's browser is code
that allows free navigation within Microsoft's
environment but not anywhere else. Listing 10.7 adds this
functionality.
Listing
10.7 frmbrowser.frmLimiting the Browser's Internet
Scope
- Private Sub
MyWeb_OnBeginNavigate(ByVal URL As String, _
- ByVal Flags
As Long, ByVal TargetFrameName As String, _
- PostData As
Variant, ByVal Headers As String, _
- ByVal
Referrer As String, Cancel As Boolean)
- If
InStr(URL, "microsoft.com") < 1 Then Cancel
= True
- End Sub
- All I am doing
here is checking the URL for microsoft.com and canceling
the navigation event if not found. This is a very
simplistic example and should be fleshed out with a
little more sophistication that reflects your needs. When
the navigation is canceled in this manner, the Web
browser generates an error event in the procedure that
called the navigate method. You will have to add
error-handling code to address this error. Listing 10.8
shows the two relevant procedures in this project
modified to handle this error.
Listing
10.8 frmbrowser.frmAdding Error Code to Compensate
for the Navigation Method Being Canceled
- Private Sub
cmbAddress_KeyPress(KeyAscii As Integer)
- On Error
GoTo BadcmbAddress_KeyPress
- Select Case
KeyAscii
- Case 13
- AddToList
cmbAddress
- MyWeb.Navigate
cmbAddress.Text
- End Select
- ExitcmbAddress_KeyPress:
- Exit Sub
- BadcmbAddress_KeyPress:
- 'trapping
fopr the canceled
- 'navigate
method
- If
Err.Number = 287 Then
- MsgBox
"This URL Not Allowed"
- Else
- MsgBox
Err.Description
- End If
- Resume
ExitcmbAddress_KeyPress
- End Sub
- Private Sub
MyTools_ButtonClick(ByVal Button As Button)
- On Error
GoTo BadMyTools_ButtonClick
- Select Case
Button.Key
- Case
"GetFile"
- 'go get a
HTML file from a local drive
- If
GetDocumentFile(strFilePath) Then
- MyWeb.Navigate
strFilePath
- End If
- Case
"GoHome"
- MyWeb.GoHome
- Case
"GoBack"
- MyWeb.GoBack
- Case
"GoForward"
- MyWeb.GoForward
- Case
"Refresh"
- MyWeb.Refresh
- Case
"Test"
- MsgBox
MyWeb.Location
- End Select
- ExitMyTools_ButtonClick:
- Exit Sub
- BadMyTools_ButtonClick:
- 'trapping
fopr the canceled
- 'navigate
method
- If
Err.Number = 287 Then
- MsgBox
"This URL Not Allowed"
- Else
- MsgBox
Err.Description
- End If
- Resume
ExitMyTools_ButtonClick
- End Sub
From
Here...
In the
release version of the Internet Explorer there will be
more Events wired in and working to give you greater
control of the WebBrowser control. Internet Explorer
gives you the ability to create custom browsers that fit
the exacting needs of an organization's
environmentfrom the corporate intranet to Internet
access for students in high-school classrooms. We did not
show examples of VBScript and Visual Basic interacting
with each other here because the Document Object was not
functional at the time of this writing. Be sure to watch
the Web site related to this book for examples.